Appendix_B_TDCC Results

lagged_correlations <- read_rds('TDL_Correlations.rds')
long_left_IMFs <- read_rds('long_series_IMFs.rds')

IMF_names <- colnames(long_left_IMFs$ADM$IMF_data[[1]]$IMFs[[1]])[1:8]
tickers <- names(long_left_IMFs)

# Function to get the announcemnt g values
announcement_g_values <- function(ticker, merged_forecast_num) {
  # returns the matching index number of generation dates for the forecast of the announcemnts. This index is equivalent to g
  announcement_g <- match(as_date(long_left_IMFs[[ticker]]$announcements), as_date(long_left_IMFs[[ticker]]$IMF_data[[merged_forecast_num]]$generation_dates)) %>% na.omit()
  
  announcement_g_df <- data.frame(g = announcement_g)
  return(announcement_g_df)
}

# Function to plot the lagged correlations
lagged_ccf_plot <- function(lagged_ccf, ticker, merged_forecast_num) {
  
  # get g values of announcemnt dates
  announce_df <- announcement_g_values(ticker, merged_forecast_num)
  
  # make the plot
  lagged_plot <- lagged_ccf %>%
  ggplot(aes(x = as.numeric(g), y = lag, fill = coef)) + 
    geom_tile() +
    scale_fill_gradient2(low = '#f4a317', mid = 'white', high = '#138ade') +
    
    labs(x = NULL,
         y = expression(lambda),
         fill = NULL) +
    scale_x_continuous(limits = c(0, NA)) +
    theme_minimal(base_size = 6) +
    theme(legend.position = 'none')
  
  # add announcements
  lagged_plot <- lagged_plot + geom_vline(data = announce_df, aes(xintercept = g), color = 'black', alpha = 0.5, linetype = 'dashed')
  return(lagged_plot)
}

# loop over each ticker and generate plots for each of the merged
# forecasts available for that ticker
foreach(ticker = tickers) %do% {
  # loop over multiple forecasts
  for (i in 1:length(lagged_correlations[[ticker]])) {
    # generate price plots for each IMF
    list_of_plots_price <- foreach(j = seq(1,8)) %do% {
    lagged_ccf_plot(lagged_correlations[[ticker]][[i]][[j]]$price_cor, ticker = ticker, merged_forecast_num = i) + labs(x = IMF_names[j])
  }
    # generate change plots for each IMF
    list_of_plots_change <- foreach(j = seq(1,8)) %do% {
    lagged_ccf_plot(lagged_correlations[[ticker]][[i]][[j]]$change_cor, ticker = ticker, merged_forecast_num = i) + labs(x = IMF_names[j])
  }
  
    # get the date range for the forecast
    
    date_range <- long_left_IMFs[[ticker]]$IMF_data[[i]]$generation_dates %>%
      as_date() %>%
      range() %>%
      format('%d %B %Y') 
      
    
    # arrange the plots in a side by side grid
    grid.arrange(
      # arrange the price as the left plots
      arrangeGrob(list_of_plots_price[[1]],
                  list_of_plots_price[[2]],
                  list_of_plots_price[[3]],
                  list_of_plots_price[[4]],
                  list_of_plots_price[[5]],
                  list_of_plots_price[[6]],
                  list_of_plots_price[[7]],
                  list_of_plots_price[[8]],
  ncol = 2, nrow = 4,
  top = text_grob( paste('Price Correlations'))
  ),
  
  # arrange change as right plots
  arrangeGrob(list_of_plots_change[[1]], 
              list_of_plots_change[[2]], 
              list_of_plots_change[[3]], 
              list_of_plots_change[[4]],
              list_of_plots_change[[5]],
              list_of_plots_change[[6]],
              list_of_plots_change[[7]], 
              list_of_plots_change[[8]],
  ncol = 2, nrow = 4, 
  top = text_grob( paste('Change Correlations'))),
  # add the ticker and forecasts as a title
  top = text_grob(paste0(ticker, ': ', date_range[1],' - ',date_range[2])), ncol = 2)
  }
    
}

## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL
## 
## [[4]]
## NULL
## 
## [[5]]
## NULL
## 
## [[6]]
## NULL
## 
## [[7]]
## NULL
## 
## [[8]]
## NULL
## 
## [[9]]
## NULL
## 
## [[10]]
## NULL
## 
## [[11]]
## NULL
## 
## [[12]]
## NULL
## 
## [[13]]
## NULL
## 
## [[14]]
## NULL
## 
## [[15]]
## NULL
## 
## [[16]]
## NULL
## 
## [[17]]
## NULL
## 
## [[18]]
## NULL
## 
## [[19]]
## NULL
## 
## [[20]]
## NULL
## 
## [[21]]
## NULL
## 
## [[22]]
## NULL